home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tcl8.0 / tests / append.test < prev    next >
Encoding:
Text File  |  1997-08-15  |  4.2 KB  |  159 lines  |  [TEXT/ALFA]

  1. # Commands covered:  append lappend
  2. #
  3. # This file contains a collection of tests for one or more of the Tcl
  4. # built-in commands.  Sourcing this file into Tcl runs the tests and
  5. # generates output for errors.  No output means no errors were found.
  6. #
  7. # Copyright (c) 1991-1993 The Regents of the University of California.
  8. # Copyright (c) 1994-1996 Sun Microsystems, Inc.
  9. #
  10. # See the file "license.terms" for information on usage and redistribution
  11. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  12. #
  13. # SCCS: @(#) append.test 1.16 97/04/09 11:29:33
  14.  
  15. if {[string compare test [info procs test]] == 1} then {source defs}
  16.  
  17. catch {unset x}
  18. test append-1.1 {append command} {
  19.     catch {unset x}
  20.     list [append x 1 2 abc "long string"] $x
  21. } {{12abclong string} {12abclong string}}
  22. test append-1.2 {append command} {
  23.     set x ""
  24.     list [append x first] [append x second] [append x third] $x
  25. } {first firstsecond firstsecondthird firstsecondthird}
  26. test append-1.3 {append command} {
  27.     set x "abcd"
  28.     append x
  29. } abcd
  30.  
  31. test append-2.1 {long appends} {
  32.     set x ""
  33.     for {set i 0} {$i < 1000} {set i [expr $i+1]} {
  34.     append x "foobar "
  35.     }
  36.     set y "foobar"
  37.     set y "$y $y $y $y $y $y $y $y $y $y"
  38.     set y "$y $y $y $y $y $y $y $y $y $y"
  39.     set y "$y $y $y $y $y $y $y $y $y $y "
  40.     expr {$x == $y}
  41. } 1
  42.  
  43. test append-3.1 {append errors} {
  44.     list [catch {append} msg] $msg
  45. } {1 {wrong # args: should be "append varName ?value value ...?"}}
  46. test append-3.2 {append errors} {
  47.     set x ""
  48.     list [catch {append x(0) 44} msg] $msg
  49. } {1 {can't set "x(0)": variable isn't array}}
  50. test append-3.3 {append errors} {
  51.     catch {unset x}
  52.     list [catch {append x} msg] $msg
  53. } {1 {can't read "x": no such variable}}
  54.  
  55. test append-4.1 {lappend command} {
  56.     catch {unset x}
  57.     list [lappend x 1 2 abc "long string"] $x
  58. } {{1 2 abc {long string}} {1 2 abc {long string}}}
  59. test append-4.2 {lappend command} {
  60.     set x ""
  61.     list [lappend x first] [lappend x second] [lappend x third] $x
  62. } {first {first second} {first second third} {first second third}}
  63. test append-4.3 {lappend command} {
  64.     proc foo {} {
  65.     global x
  66.     set x old
  67.     unset x
  68.     lappend x new
  69.     }
  70.     set result [foo]
  71.     rename foo {}
  72.     set result
  73. } {new}
  74. test append-4.4 {lappend command} {
  75.     set x {}
  76.     lappend x \{\  abc
  77. } {\{\  abc}
  78. test append-4.5 {lappend command} {
  79.     set x {}
  80.     lappend x \{ abc
  81. } {\{ abc}
  82. test append-4.6 {lappend command} {
  83.     set x {1 2 3}
  84.     lappend x
  85. } {1 2 3}
  86. test append-4.7 {lappend command} {
  87.     set x "a\{"
  88.     lappend x abc
  89. } "a\\\{ abc"
  90. test append-4.8 {lappend command} {
  91.     set x "\\\{"
  92.     lappend x abc
  93. } "\\{ abc"
  94. test append-4.9 {lappend command} {
  95.     set x " \{"
  96.     list [catch {lappend x abc} msg] $msg
  97. } {1 {unmatched open brace in list}}
  98. test append-4.10 {lappend command} {
  99.     set x "    \{"
  100.     list [catch {lappend x abc} msg] $msg
  101. } {1 {unmatched open brace in list}}
  102. test append-4.11 {lappend command} {
  103.     set x "\{\{\{"
  104.     list [catch {lappend x abc} msg] $msg
  105. } {1 {unmatched open brace in list}}
  106. test append-4.12 {lappend command} {
  107.     set x "x \{\{\{"
  108.     list [catch {lappend x abc} msg] $msg
  109. } {1 {unmatched open brace in list}}
  110. test append-4.13 {lappend command} {
  111.     set x "x\{\{\{"
  112.     lappend x abc
  113. } "x\\\{\\\{\\\{ abc"
  114. test append-4.14 {lappend command} {
  115.     set x " "
  116.     lappend x abc
  117. } "abc"
  118. test append-4.15 {lappend command} {
  119.     set x "\\ "
  120.     lappend x abc
  121. } "{ } abc"
  122. test append-4.16 {lappend command} {
  123.     set x "x "
  124.     lappend x abc
  125. } "x abc"
  126. test append-4.17 {lappend command} {
  127.     catch {unset x}
  128.     lappend x
  129. } {}
  130.  
  131. proc check {var size} {
  132.     set l [llength $var]
  133.     if {$l != $size} {
  134.     return "length mismatch: should have been $size, was $l"
  135.     }
  136.     for {set i 0} {$i < $size} {set i [expr $i+1]} {
  137.     set j [lindex $var $i]
  138.     if {$j != "item $i"} {
  139.         return "element $i should have been \"item $i\", was \"$j\""
  140.     }
  141.     }
  142.     return ok
  143. }
  144. test append-5.1 {long lappends} {
  145.     set x ""
  146.     for {set i 0} {$i < 300} {set i [expr $i+1]} {
  147.     lappend x "item $i"
  148.     }
  149.     check $x 300
  150. } ok
  151.  
  152. test append-6.1 {lappend errors} {
  153.     list [catch {lappend} msg] $msg
  154. } {1 {wrong # args: should be "lappend varName ?value value ...?"}}
  155. test append-6.2 {lappend errors} {
  156.     set x ""
  157.     list [catch {lappend x(0) 44} msg] $msg
  158. } {1 {can't set "x(0)": variable isn't array}}
  159.